Quick PC 61/Quick PC 61.iso/I386/SASETUP.MSI/F77717_site_new.asp

Text File | 2003-02-21 | 42.7 KB | 1,402 lines

<%@ Language=VBScript   %>
<%    Option Explicit     %>
<%
'    Response.Buffer = True
    '-------------------------------------------------------------------------
    '    site_new.asp: Serves in creating a new site
    '
    ' Copyright (c) Microsoft Corporation.  All rights reserved.
    '
    '    Date            Description
    '    14-Jan-2001        Creation Date
    '    25-Jan-2001        Last Modified Date
    '-------------------------------------------------------------------------
%>

    <!-- #include virtual="/admin/inc_framework.asp" -->
    <!-- #include file="resources.asp" -->
    <!-- #include file="inc_wsa.asp" -->
    <!-- #include file="Sitenew_prop.asp" -->
<%

    Err.Clear
    'On Error Resume Next
    '-------------------------------------------------------------------------
    ' Global Constants and Variables
    '-------------------------------------------------------------------------
    Dim G_strAnonName        'to hold Anonymous name
    Dim G_strAnonPwd        'to hold Anonymous pwd
    Dim G_strDirRoot        'to hold Domainname value
    Dim G_strSysName        'to hold system name
    Dim G_Browser_Grp        'to hold Browsers group for AD Scenario
    Dim G_Admin_Grp            'to hold Admin group for AD Scenario
    Dim G_Authors_Grp        'to hold Authors group for AD scenario
    Dim G_strSiteName        'to hold site name
    Dim G_AnonUserName        'to hold anonymouse username created by IIS

    Dim rc                    'to hold return count value
    Dim page                'to hold page object

    Dim idTabGeneral        'to hold Ist tab value
    Dim idTabSiteID            'to hold IInd tab value
    Dim idTabAppSetting        'to hold Vth tab value

    '=========================================================================
    ' Entry point
    '=========================================================================
    '
    ' Set username value
    G_AnonUserName = GetIISAnonUsername()

    'Create a Tabbed Property Page
    rc = SA_CreatePage( L_CREATETASKTITLE_TEXT, "", PT_TABBED, page )

    ' Add five tabs
    rc = SA_AddTabPage( page, L_GENERAL_TEXT, idTabGeneral)
    rc = SA_AddTabPage( page, L_SITEIDENTITY_TEXT, idTabSiteID)
    rc = SA_AddTabPage( page, L_APPLICATIONSETTINGS_TEXT, idTabAppSetting)

    ' Show the page
    rc = SA_ShowPage( page )

    '=========================================================================
    ' Web Framework Event Handlers
    '=========================================================================

    '-------------------------------------------------------------------------
    ' Function:    OnInitPage
    '
    ' Synopsis:    Called to signal first time processing for this page. Use
    '            this method to do first time initialization tasks.
    '
    ' Returns:    TRUE to indicate initialization was successful. FALSE to
    '            indicate errors. Returning FALSE will cause the page to be
    '            abandoned.
    '
    '-------------------------------------------------------------------------
    Public Function OnInitPage(ByRef PageIn, ByRef EventArg)
        On Error Resume Next

        Call GetDomainRole( G_strDirRoot, G_strSysName )

        'init the checkbox
        F_strCreatePathChecked = "true"

        '
        'We won't support create Domain Admin Site anymore
        F_strAccountLocation = "1"

        OnInitPage = TRUE
    End Function

    '-------------------------------------------------------------------------
    ' Function:    OnPostBackPage
    '
    ' Synopsis:    Called to signal that the page has been posted-back. A post-
    '            back occurs in tabbed property pages and wizards as the user
    '            navigates through pages. It is differentiated from a Submit
    '            or Close operationin that the user is still working with the
    '            page.
    '
    '            The PostBack event should be used to save the state of page.
    '
    ' Returns:    TRUE to indicate initialization was successful. FALSE to
    '            indicate errors. Returning FALSE will cause the page to be
    '            abandoned.
    '-------------------------------------------------------------------------
    Public Function OnPostBackPage(ByRef PageIn, ByRef EventArg)
        Err.clear
        on Error Resume Next

        'get variables from form
        call SetGenFormVariables()

        call SetSiteIdentitiesFormVariables()

        call SetApplnSettingsFormVariables()

        Call SA_TRACEOUT("OnPostBackPage","OnPostBackPage called")

        OnPostBackPage = TRUE

    End Function


    '--------------------------------------------------------------------------
    ' Function:    OnServeTabbedPropertyPage
    '
    ' Synopsis:    Called when the page needs to be served. Use this method to
    '            serve content.
    '
    ' Returns:    TRUE to indicate not problems occured. FALSE to indicate errors.
    '            Returning FALSE will cause the page to be abandoned.
    '
    '--------------------------------------------------------------------------
    Public Function OnServeTabbedPropertyPage(ByRef PageIn, _
                                            ByVal iTab, _
                                            ByVal bIsVisible, _
                                            ByRef EventArg)
        ' Emit Web Framework required functions
        If ( iTab = idTabGeneral) Then
            Call ServeCommonJavaScript()
        End If

        ' Emit content for the requested tab
        Select Case iTab
            Case idTabGeneral
                Call ServeTabGeneral(PageIn, bIsVisible)
            Case idTabSiteID
                Call ServeTabSiteID(PageIn, bIsVisible)
            Case idTabAppSetting
                Call ServeTabAppSetting(PageIn, bIsVisible)
            Case Else
                SA_TraceOut "TEMPLAGE_TABBED", _
                    "OnServeTabbedPropertyPage unrecognized tab id: " + _
                    CStr(iTab)
        End Select

        OnServeTabbedPropertyPage = TRUE
    End Function


    '-------------------------------------------------------------------------
    ' Function:    OnSubmitPage
    '
    ' Synopsis:    Called when the page has been submitted for processing. Use
    '            this method to process the submit request.
    '
    ' Returns:    TRUE if the submit was successful, FALSE to indicate error(s).
    '            Returning FALSE will cause the page to be served again using
    '            a call to OnServePropertyPage.
    '
    '-------------------------------------------------------------------------
    Public Function OnSubmitPage(ByRef PageIn, ByRef EventArg)
        OnSubmitPage = CreateSite()
    End Function

    '-------------------------------------------------------------------------
    ' Function:    OnClosePage
    '
    ' Synopsis:    Called when the page is about to be closed. Use this method
    '            to perform clean-up processing.
    '
    ' Returns:    TRUE to allow close, FALSE to prevent close. Returning FALSE
    '            will result in a call to OnServePropertyPage.
    '
    '-------------------------------------------------------------------------
    Public Function OnClosePage(ByRef PageIn, ByRef EventArg)
        OnClosePage = TRUE
    End Function


    '=========================================================================
    ' Private Functions
    '=========================================================================

    '-------------------------------------------------------------------------
    'Function name        :ServeTabGeneral
    'Description        :Serves General tab
    'Input Variables    :PageIn, bIsVisible
    'Output Variables    :None
    'Returns            :Success(Return value)
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function ServeTabGeneral(ByRef PageIn, ByVal bIsVisible)

        If ( bIsVisible ) Then

            call GeneralViewTab()

        Else
            'update hidden variables
            call GeneralHiddenTab()

         End If

        ServeTabGeneral = gc_ERR_SUCCESS

    End Function


    '-------------------------------------------------------------------------
    'Function name        :ServeTabSiteID
    'Description        :Serves the Site identities tab
    'Input Variables    :PageIn, bIsVisible
    'Output Variables    :None
    'Returns            :Success(Return value)
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function ServeTabSiteID(ByRef PageIn, ByVal bIsVisible)

        If ( bIsVisible ) Then

            call SiteIdentitiesViewTab()

        Else
            'update hidden variables

            call SiteIdentitiesHiddenTab()

         End If

        ServeTabSiteID = gc_ERR_SUCCESS

    End Function


    '-------------------------------------------------------------------------
    'Function name        :ServeTabAppSetting
    'Description        :Serve the Application Settings tab
    'Input Variables    :PageIn, bIsVisible
    'Output Variables    :None
    'Returns            :Success(Return value)
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function ServeTabAppSetting(ByRef PageIn, ByVal bIsVisible)


        If ( bIsVisible ) Then

            call ApplicationSettingsViewTab()

        Else
            'update hidden variables

            call ApplicationSettingsHiddenTab()

        end if

        ServeTabAppSetting = gc_ERR_SUCCESS

    End Function

    '-------------------------------------------------------------------------
    ' Function:    ServeCommonJavaScript
    '
    ' Synopsis:    Common javascript functions that are required by the Web
    '            Framework.
    '
    '------------------------------------------------------------------------
    Function ServeCommonJavaScript()

        Err.clear
        on Error Resume Next

    %>
        <script language="JavaScript" src="<%=m_VirtualRoot%>inc_global.js">
        </script>

        <script language="JavaScript">
        //
        // Microsoft Server Appliance Web Framework Support Functions
        // Copyright (c) Microsoft Corporation.  All rights reserved.
        //
        // Init Function
        // -----------
        // This function is called by the Property Page web framework to
        // allow the page to perform first time initialization.
        //
        // This function must be included or a javascript runtime error will
        // occur.

        function Init()
            {
                //Get the selected tab
                var temp = top.main.document.forms['frmTask'].TabSelected.value;

                switch(temp)
                {
                    //for General prop
                    case '0':
                        GenInit();
                        break;
                    //for Site prop
                    case '1':
                        SiteInit();
                        break;
                    //for Appl prop
                    case '2':
                        ApplInit();
                        break;
                }
            }



        // ValidatePage Function
        // ------------------
        // This function is called by the Property Page framework as part of
        // the submit processing. Use this function to validate user input.
        // Returning false will cause the submit to abort.
        //
        // This function must be included or a javascript runtime error will
        // occur.
        // Returns: True if the page is OK, false if error(s) exist.

        function ValidatePage()
        {

            //Get the selected tab
            var temp = top.main.document.forms['frmTask'].TabSelected.value;

            switch(temp)
            {
                //for general prop
                case '0':
                    return GenValidatePage();
                    break;
                //for Site prop
                case '1':
                    return SiteValidatePage();
                    break;
                //for Appl prop
                case '2':
                    return ApplValidatePage();
                    break;
            }
        }

        // SetData Function
        // --------------
        // This function is called by the Property Page framework and is called
        // only if ValidatePage returned a success (true) code. Typically you
        // would modify hidden form fields at this point.
        //
        // This function must be included or a javascript runtime error will
        // occur.
        function SetData()
        {

            //Get the selected tab
            var temp = top.main.document.forms['frmTask'].TabSelected.value;

            switch(temp)
            {
                //for general prop
                case '0':
                    GenSetData();
                    break;
                //for Site prop
                case '1':
                    SiteSetData();
                    break;
                //for Appl prop
                case '2':
                    ApplSetData();
                    break;
            }
        }
        </script>
    <%
    End Function

    '----------------------------------------------------------------------------
    'Function name        :CreateSite
    'Description        :Serves in Creating a New Web Site
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean (True if new site is created else returns False)
    'Global Variables    :None
    'Functions Used        :blnValidateInputs
    '                     HandleWrkgrpAndNTDC
    '                     blnCreateWebSite
    '                     blnSetDiskQuotas
    '                      blnSetDACLEntry
    '----------------------------------------------------------------------------
    Function CreateSite()
        on error resume next
        Err.Clear

        Call SA_TraceOut(SA_GetScriptFileName(), "Entering CreateSite()")

        Dim objRoot            'holds root object
        Dim strUserName        'hold user name
        Dim WebName            'hold web name
        Dim strBool

        CreateSite = FALSE

        Call GetDomainRole( G_strDirRoot, G_strSysName )

        Call SA_TraceOut(SA_GetScriptFileName(), "System name: " + CStr(G_strSysName))
        Call SA_TraceOut(SA_GetScriptFileName(), "Directory root: " + CStr(G_strDirRoot))

        ' Bind to the root object
        If F_strAccountLocation = "1" Then
            Set objRoot = GetObject("WinNT://" & G_strSysName)
        Else
            Set objRoot = GetObject("WinNT://" & G_strDirRoot)
        End If

        If Err.number <> 0 Then
            Call SA_TraceOut(SA_GetScriptFileName(), "Error creating Root object, error: " + CStr(Hex(Err.Number)) + " " + Err.Description)
            Call SA_SetErrMsg(SA_GetLocString("Sitearea.dll", "C04201D4", Array("WinNT://" & G_strDirRoot)))
            Exit Function
        End if

        '
        ' If an existing account was specified then the account name needs to be
        ' in the form ComputerName\AccountName. If the user did not enter the name
        ' in this form, then correct the name to match this format.
        If ( F_strAccountLocation = "2" ) Then
            If ( InStr(F_strAdminName, "\") = 0 ) Then
                F_strAdminName = G_strSysName & "\" & F_strAdminName
            End If
        End If


        'user and groups names to be created
        G_strAnonName = F_strSiteID &  "_Anon"
        G_Browser_Grp = F_strSiteID & "_Browsers"
        G_Admin_Grp = F_strSiteID & "_Admins"
        G_Authors_Grp = F_strSiteID & "_Authors"

        '1) verify input datas
        if ( NOT blnValidateInputs()) then
            Call SA_TraceOut(SA_GetScriptFileName(), "Error in input parameters")
            Exit Function
        End If

        '2) Create site users and generate the anonymous user's pwd
        If ( NOT CreateSiteUsers(objRoot)) Then
            Call SA_TraceOut(SA_GetScriptFileName(), "CreateSiteUsers error: " + CStr(Hex(Err.Number)) + " " + Err.Description)
            Exit Function
        End If

        '3) Create Web site. Use the Admin and Anon users created above for this
        If( NOT blnCreateWebSite(F_strSiteID, _
                              F_strIPAddr, _
                              F_strPort, _
                              F_strHeader, _
                              F_strDir, _
                              F_strchkAllow, _
                              F_selectActiveFormat, _
                              F_strAdminName, _
                              F_strDefaultPageText)) then
            Call SA_TraceOut(SA_GetScriptFileName(),  "CreateWebSite error: " + CStr(Hex(Err.Number)) + " " + Err.Description)

            ' If we did not use an existing user account then we need to
            ' delete the accounts we created (see CreateSiteUsers function).
            If (F_strAccountLocation <> "2") Then
                Call blnDeleteUser(objRoot, F_strAdminName)
                Call blnDeleteUser(objRoot, G_strAnonName)
            end if

             SA_ServeFailurePage L_CREATEFAIL_ERRORMESSAGE
            exit function
        end if 'create site

        '4)Config directory DACL
        If(NOT ConfigDirDACL(F_strDir, F_strAdminName)) Then
            Call SA_TraceOut(SA_GetScriptFileName(),  "ConfigDirDACL error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
            Exit Function
        End If

        '6) config virtual FTP site
        If F_strUploadMethod = UPLOADMETHOD_FTP Then
            Dim objService
            Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
            If (NOT CreateVirFTPSite(objService, F_strAdminName, F_strDir, True, True, True)) Then
                Call SA_TraceOut(SA_GetScriptFileName(),  "CreateVirFTPSite error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
                SetErrMsg L_ERR_CREATE_VIR_FTP_SITE
                If ( Len(GetErrMsg()) <= 0 ) Then
                    Call SA_SetErrMsg(GetLocString("sitearea.dll", "404201DC", ""))
                End If
                Exit Function
            End If
            Set objService = Nothing
        End If

        '7) Setting return URL
        WebName = GetWebSiteNo(F_strSiteID)
        Call SA_TraceOut(SA_GetScriptFileName(), "New WebSite ID: " + CStr(WebName))

        Call SA_MungeURL(mstrReturnURL, "PKey",WebName)
        Call SA_TraceOut(SA_GetScriptFileName(), "ReturnURL: " + mstrReturnURL)

        '5) Config Frontpage
        If( NOT ConfigFrontPage(F_strAdminName)) Then
            Call SA_TraceOut(SA_GetScriptFileName(),  "ConfigFrontPage error: "+ CStr(Hex(Err.Number)) + " " + Err.Description)
            If ( Len(GetErrMsg()) <= 0 ) Then
                Call SA_SetErrMsg(L_ERR_FRONTPAGE_CONFIGURATION)
            End If
            Exit Function
        End If
        CreateSite = TRUE
        Call SA_TraceOut(SA_GetScriptFileName(), "CreateSite() return code: " + CStr(CreateSite))

         'release objects
        'Set objRoot = nothing
    end function

    '----------------------------------------------------------------------------
    'Function name        :CreateSiteUsers
    'Description        :Serves in create administrator users
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean (True if new site is created else returns False)
    'Global Variables    :None
    'Functions Used        :
    '----------------------------------------------------------------------------
    Function CreateSiteUsers(ByRef objRoot)
        On Error Resume Next
        Err.Clear

        CreateSiteUsers = False
        'creates necessary ou's, users and groups, cleansup if
        'something fails
        If F_strAccountLocation = "1" then
            'creates necessary users , cleansup if something fails
            if NOT HandleWrkgrpAndNTDC(objRoot) then
                exit function
            end if
        Elseif F_strAccountLocation = "2" Then
            'valid the exist user and prompt the user when err
            Dim objComputer
            Dim oUser
            Dim arrId
            Dim strDomain
            Dim strUser

            arrId = split(F_strAdminName,"\")

            If ubound(arrId) <> 1 Then
                SetErrMsg L_ERR_ADMINISTRATOR_NAME
                Exit Function
            End If

            strDomain = arrId(0)
            strUser = arrId(1)

            set objComputer = GetObject("WinNT://" & strDomain)
            If Err.number <> 0 Then
                SetErrMsg SA_GetLocString("Sitearea.dll", _
                            "C04201D4", _
                            Array("WinNT://" & strDomain))
                Exit Function
            End if

            Set oUser = objComputer.GetObject("user" , trim(strUser))
            If Err.number <> 0 Then
                SetErrMsg L_ERR_ACCOUNT_NOT_FOUND
                Exit Function
            End if
        End If
        CreateSiteUsers = True
    End Function

    '----------------------------------------------------------------------------
    'Function name        :ConfigDirDACL
    'Description        :Serves in set permission of directory
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean (True if new site is created else returns False)
    'Global Variables    :None
    'Functions Used        :
    '----------------------------------------------------------------------------

    Function ConfigDirDACL(strDir,strAdminName)
        On Error Resume Next
        Err.Clear

        ConfigDirDACL = False

        ' Set DACL entries for Anon and Admin users for Home Directory
         if (NOT SetDaclForRootDir(strDir,strAdminName)) then
             Call SA_SetErrMsg(L_DACL_ERRORMESSAGE)
            Call SA_TraceOut ("site_new", "Failed to set the DACL for root dir ")
            Exit Function
        end if
        ConfigDirDACL = True
    End Function

    '----------------------------------------------------------------------------
    'Function name        :ConfigFrontPage
    'Description        :Serves in config front page
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean (True if new site is created else returns False)
    'Global Variables    :None
    'Functions Used        :
    '----------------------------------------------------------------------------
    Function ConfigFrontPage(strAdminName)
        On Error Resume Next
        Err.Clear

        Dim objService
        Dim strUserName

        Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)
        ConfigFrontPage = True

        '
        ' Configure FrontPage Server Extensions if they are installed and were
        ' selected by the user.
        '
        If ( TRUE = isFrontPageInstalled(objService) And _
             UPLOADMETHOD_FPSE = F_strUploadMethod) Then

            ConfigFrontPage = False

            '
            ' User name depends on account type
            select case F_strAccountLocation

                case "1"
                    strUserName = G_strSysName & "\" & strAdminName

                case "2"
                    strUserName = strAdminName

                case else
                    Call SA_TraceOut(SA_GetScriptFileName(), "Function ConfigFrontPage encountered unexpected AccountLocation code: " + CStr(F_strAccountLocation))
                    Exit Function
            end select

            ConfigFrontPage = UpdateFrontPage(True, G_strSiteName, strUserName)
        End If
    End Function

    '-------------------------------------------------------------------------
    'Function name        :HandleWrkgrpAndNTDC
    'Description        :Creates req users in case of Workgrp and NTDC scenario
    'Input Variables    :objRoot
    'Output Variables    :None
    'Returns            :boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function HandleWrkgrpAndNTDC( objRoot )
        Err.Clear
        On Error Resume Next

        Dim objSAHelper
        Dim strPassword
        Dim bCreatingAnon

        HandleWrkgrpAndNTDC = FALSE

        'If we are creating Anonymous account we need to set these properties to
        ' TRUE
        ' 1) Password Never Expires
        ' 2) User cannot change password


        bCreatingAnon = False

        ' Create Admin user first because it is used for setting site operator
        if ( Not blnCreateUser(objRoot, F_strAdminName, F_strAdminPswd, bCreatingAnon) ) then
            Exit Function
        End If


        Set objSAHelper = server.CreateObject("ServerAppliance.SAHelper")

        if Err.number <> 0 then
            Call SA_TraceOut ("site_new", "createobject for sahelper failed")
            exit function
        else
            strPassword = objSAHelper.GenerateRandomPassword(14)
            if Err.number <> 0 then
                Call SA_TraceOut ("site_new", "generate random password failed")
                Set objSAHelper = Nothing
                exit function
            end if
        end if

        Set objSAHelper = Nothing

        'Create Anonymous user for setting anonymous user settings in the web
        'site
        SA_traceOut "G_strAnonName:", G_strAnonName
        bCreatingAnon = True
        '
        'Set the pwd of the anonymous user, it needs to be used when we set the webvirdir object.
        'That's because of the IIS security change, which won't install sub-authenticator from
        'installation.
        G_strAnonPwd = strPassword
        SA_TraceOut "G_strAnonPwd:", G_strAnonPwd
        if ( Not blnCreateUser(objRoot, G_strAnonName, strPassword, bCreatingAnon) ) then
            Call blnDeleteUser(objRoot, F_strAdminName)
            Exit Function
        End If


        HandleWrkgrpAndNTDC = TRUE
    End Function

    '-------------------------------------------------------------------------
    'Function name        :blnValidateInputs
    'Description        :Validate Site identifier, directory path and admin
    '                     user
    'Input Variables    :
    'Output Variables    :None
    'Returns            :boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function blnValidateInputs()
        Err.clear
        On Error Resume Next

        blnValidateInputs = FALSE

        Dim arrFullName

        '1) Check whether the site Identifier exists
        If F_strAccountLocation = "1" Then
            if isValidSiteIdentifier(F_strSiteID, F_strAdminName, G_strSysName, True) = false then
                mintTabSelected = 0
                SetErrMsg SA_GetLocString("Sitearea.dll", _
                                    "C04200C1", _
                                    Array(F_strSiteID))
                exit Function
            end if
        Elseif F_strAccountLocation = "2" Then
            if isValidSiteIdentifier(F_strSiteID, "", "", False) = false then
                mintTabSelected = 0
                SetErrMsg SA_GetLocString("Sitearea.dll", _
                                    "C04200C1", _
                                    Array(F_strSiteID))
                exit Function
            end if
        End If


        '2) validates the dir and create the dir if necessary
        if (NOT ValidateSitePath(F_strCreatePathChecked, F_strDir)) then
            exit function
        end if

        Call SA_TraceOut( "site_new", "validateinputs successful" )
        blnValidateInputs = true
    end function

    '-------------------------------------------------------------------------
    'Function name        :blnCreateUser
    'Description        :Function to create user
    'Input Variables    :objRoot, strUserName, strPassword
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :None
    '
    '-------------------------------------------------------------------------
    Function blnCreateUser(objRoot, strUserName, strPassword, bCreatingAnon)

        Dim objUser            'holds user object
        Dim flagPasswd

        Err.Clear
        On Error Resume Next

        blnCreateUser = false

        ' create Admin user in SAM
        Set objUser = objRoot.Create("user" , trim(strUserName))
        objUser.setPassword(trim(strPassword))
        objUser.FullName    = strUserName
        objUser.Description = strUserName

        'If we are creating Anonymous account we need to set these properties to
        ' TRUE
        ' 1) Password Never Expires
        ' 2) User cannot change password
        If bCreatingAnon Then
            flagPasswd = &H10040
            objUser.Put "userFlags", flagPasswd
        End If

        objUser.SetInfo()

        If Err.number <> 0 Then
            mintTabSelected = 0
            If Err.number = &H800708C5 Then
                SetErrMsg L_ERR_PASSWORD_POLICY
            Else
                SetErrMsg L_UNABLETOSET_PASSWORD_ERRORMESSAGE
            End If
            exit Function
        end if

        'release objects
        set objUser = nothing
        SA_traceout "blncreateuser success: strUserName", strUserName

        blnCreateUser = true

    End function

    '-------------------------------------------------------------------------
    'Function name        :blnCreateWebSite
    'Description        :Creating new web site
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean (True if new site is created else returns
    '                     False)
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function blnCreateWebSite(strSiteID, _
                              strIPAddr, _
                              strPort, _
                              strHeader, _
                              strDir, _
                              strchkAllow, _
                              selectActiveFormat, _
                              strAdminName, _
                              strDefaultPageText)
        On Error Resume Next
        Err.Clear

        Dim objService        'holds WMI connection object
        Dim objMasterWeb    'holds MasterWeb Connection
        Dim instWeb            'holds intance web
        Dim retVal            'holds return value
        Dim arrBindings        'holds arraybinidngs object
        Dim nNewSiteNo        'holds new site number
        Dim strSiteNum        'holds new site name
        Dim objSetting        'holds WMI Connection object
        Dim bIIS            'Allow IIS control password
        Dim siteName

        Dim strAnonPropUserName,strAnonPropPwd

        'strAnonPropPwd holds the pwd of the anon user created
        strAnonPropPwd = ""

            Call SA_TraceOut ("site_new", "In handle blnCreateWebSite function")

            blnCreateWebSite = FALSE

            nNewSiteNo = GetNewSiteNo()

            '
            ' Delete any existing FrontPage Extension configuration for this new web site. We need
            ' to do this because FPSE does not clean-up after itself when a site is deleted. If someone
            ' manually deletes a site using the IIS snap-in, FPSE configuration information is left in the REG
            ' and we need to clear that out so the previous setting do not interfere with this new site.
            siteName = "W3SVC/"+CStr(nNewSiteNo)
            Call SA_TraceOut(SA_GetScriptFileName(), "Calling UpdateFrontPage(false, " & siteName & ", " & strAdminName & ") to delete FPSE")
            Call UpdateFrontPage("false", siteName, strAdminName)

            'Get ServerBindings Value
            arrBindings = array(GetBindings(strIPAddr, strPort, strHeader))

            Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)

            Set instWeb = objService.Get(GetIISWMIProviderClassName("IIs_WebService") & ".Name='W3SVC'")

            If Err.Number  <> 0 Then
                SetErrMsg L_INFORMATION_ERRORMESSAGE
                Exit Function
            End If

            If IsIIS60Installed() Then

                ' In IIS 6.0 WMI, Create a new web site needs to call CreateNewSite
                ' and it takes ServerBinding object as input argument instead of using
                ' a array of strings for bindings

                Dim arrObjBindings(0)

                set arrObjBindings(0) = objService.Get("ServerBinding").SpawnInstance_

                arrObjBindings(0).Port = strPort
                arrObjBindings(0).IP = strIPAddr
                arrObjBindings(0).Hostname = strHeader

                ' Create the website thru 6.0 WMI provider
                instWeb.CreateNewSite strSiteID, arrObjBindings, strDir, nNewSiteNo

            Else
                retVal = instWeb.CreateNewServer(nNewSiteNo, strSiteID,    arrBindings, strDir)

            End If

            If Err.Number  <> 0 Then
                SetErrMsg L_CREATEFAIL_ERRORMESSAGE
                Exit Function
            End If

            instWeb.Put_(WBEMFLAG) ' register the object created
            If Err.Number  <> 0 Then
                SetErrMsg L_UPDATEFAIL_ERRORMESSAGE
                Exit Function
            End If

            strSiteNum = instWeb.Name &  "/" & nNewSiteNo
            ' Get the Internal Site Identifier of the created Web site
            G_strSiteName = strSiteNum

            '1) Set ServerID property for newly created site
            if MakeManagedSite(objService, strSiteNum,strSiteID) = false then
                SetErrMsg L_CRMANAGEDSITE_REGKEY_ERRORMESSAGE
                'delete site and exit
                retVal = DeleteWebSite( objService, strSiteNum )
                Exit Function
            end if

            If F_strAccountLocation = "1" Then
                strAnonPropUserName=G_strAnonName
                'Set the pwd to the generated pwd for anon user
                strAnonPropPwd = G_strAnonPwd
            Else ' (F_strAccountLocation = "2")
                strAnonPropUserName = G_AnonUserName
            End If
            bIIS = True

            if NOT SetAnonProp(objService, strSiteNum, strchkAllow, _
                strAnonPropUserName, strAnonPropPwd, bIIS) then
                retVal = DeleteWebSite( objService, strSiteNum )
                Exit Function
            end if

            '2) Create Site Operator
            if NOT blnCreateIISOperator(objService, strSiteNum,strAdminName) then
                retVal = DeleteWebSite( objService, strSiteNum )
                Call SA_TRACEOUT("blnCreateWebSite","Create Site Operator failed")
                Exit Function
            end if

            '3) Set Access Read properties for Site
            if selectActiveFormat = "" then
                Set objSetting =objService.Get(GetIISWMIProviderClassName("IIs_WebServiceSetting") & ".Name='W3SVC'")
                if objSetting.Name = "W3SVC" then
                    if objSetting.AccessExecute = TRUE and _
                        objSetting.AccessScript = TRUE then
                        selectActiveFormat = 2
                    elseif objSetting.AccessExecute = false and _
                        objSetting.AccessScript = TRUE then
                        selectActiveFormat = 1
                    elseif objSetting.AccessExecute = false and _
                        objSetting.AccessScript = false then
                        selectActiveFormat =0
                    elseif isnull(objSetting.AccessExecute) and _
                        isnull(objSetting.AccessScript) then
                        selectActiveFormat = 0
                    end if
                end    if
                'Release the object
                set objSetting = nothing
            end if

            '4) Set execute perms for Site
            if NOT SetExecPerms(selectActiveFormat, objService, _
                strSiteNum) then
                retVal = DeleteWebSite( objService, strSiteNum )
                Exit Function
            end if

            '5) Set Access Read properties for Site
            if NOT SetApplRead( objService, strSiteNum) then
                retVal = DeleteWebSite( objService, strSiteNum )
                Exit Function
            end if

            '6) Set default web page
            if NOT SetWebDefaultPage( objService, strDefaultPageText, strSiteNum) then
                retVal = DeleteWebSite( objService, strSiteNum )
                Exit Function
            end if

            '7) Start the Website
            retVal = StartWebSite(objService, strSiteNum )

        'next

        Call SA_TraceOut ( "site_new.asp", "blnCreateWebSite Suceesfull" )
        'release objects
        set objService = nothing
        set objMasterWeb = nothing
        blnCreateWebSite = true
    End function

    '-------------------------------------------------------------------------
    'Function name        :SetDaclForRootDir
    'Description        :Sets the DACL for root dir
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :F_strDir, G_strAnonName, F_strAdminName
    '-------------------------------------------------------------------------
    Function SetDaclForRootDir(byref strDir, strAdminName)
        On Error Resume Next
        Err.Clear

        SetDaclForRootDir = FALSE

        Dim objService            'to hold WMI connection object
        Dim strTemp                'to hold temp value
        Dim objSecSetting        'to hold security setting value
        Dim objSecDescriptor    'to hold security descriptor value
        Dim strPath                'to hold Path
        Dim objDACL                'to hold DACL value
        Dim objSiteAdminAce        'to hold site ACE
        Dim objAdminAce            'to hold Admine ace

        Dim objAnonAce            'to hold Anon ace
        Dim objAuthAce            'to hold Auth ace
        Dim objDomainAce        'to hold domain admin ace
        Dim retval                'holds return value

        Set objService = getWMIConnection(CONST_WMI_WIN32_NAMESPACE)
        objService.security_.impersonationlevel = 3

        'get the sec seting for file
        strPath = "Win32_LogicalFileSecuritySetting.Path='" & strDir & "'"
        set objSecSetting = objService.Get(strPath)
        if Err.number <> 0 then
            Call SA_TraceOut ("site_new", "Failed to get Sec object for dir ")
            exit function
        end if

        'get the ace's for all req users

        If F_strAccountLocation = "1" Then
            '
            ' add access user to root dir
            '
            if NOT GetUserAce(objService, strAdminName , G_strSysName, _
                CONST_FULLCONROL, objSiteAdminAce ) then
                Call SA_TraceOut ("site_new", _
                    "Failed to get ACE object for Site Admin user ")
                    exit function
            end if

            if NOT GetUserAce(objService, G_strAnonName, G_strSysName, _
                CONST_READEXEC, objAnonAce ) then
                Call SA_TraceOut ( "site_new", _
                    "Failed to get ACE object for Anon user ")
                exit function
            end if
            '
            ' add access group to root dir
            '
            if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
                CONST_FULLCONROL, objAdminAce ) then
                Call SA_TraceOut ("site_new", _
                    "Failed to get ACE object for Admin user")
                exit function
            end if

        Elseif F_strAccountLocation = "2" Then
            Dim arrId
            Dim strDomain
            Dim strUser

            arrId = split(F_strAdminName,"\")

            If ubound(arrId) <> 1 Then
                SetErrMsg L_ERR_ADMINISTRATOR_NAME
                Exit Function
            End If

            strDomain = arrId(0)
            strUser = arrId(1)

            'add access users in the location
            if NOT GetUserAce(objService, strUser , strDomain, _
                CONST_FULLCONROL, objSiteAdminAce ) then
                Call SA_TraceOut ("site_new", _
                    "Failed to get ACE object for Site Admin user ")
                exit function
            end if

            'IUSR_hostname (anonymous username created by IIS)
            if NOT GetUserAce(objService, G_AnonUserName , G_strSysName, _
                CONST_READEXEC, objAnonAce ) then
                Call SA_TraceOut ("site_new", _
                    "Failed to get ACE object for Admin user")
                exit function
            end if
            'add access group in the location

            If ucase(strDomain) = ucase(G_strSysName) Then
                if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
                    CONST_FULLCONROL, objAdminAce ) then
                    Call SA_TraceOut ("site_new", _
                        "Failed to get ACE object for Admin user")
                    exit function
                end if
            Else
                if NOT GetGroupAce(objService, SA_GetAccount_Administrators() , GetComputerName(), _
                    CONST_FULLCONROL, objAdminAce ) then
                    Call SA_TraceOut ("site_new", _
                        "Failed to get ACE object for Admin user")
                    exit function
                end if
                if NOT GetGroupAce(objService, "Domain Admins" , strDomain,_
                    CONST_FULLCONROL, objDomainAce ) then
                    Call SA_TraceOut ("site_new", _
                        "Failed to get ACE object for Admin user")
                    exit function
                end if
            End if
        End If

        Set objSecDescriptor = objService.Get("Win32_SecurityDescriptor").SpawnInstance_()
        if Err.Number <> 0 then
            Call SA_TraceOut ("site_new", _
                "Failed to get create the Win32_SecurityDescriptor object ")
            exit function
        end if

        objSecDescriptor.Properties_.Item("DACL") = Array()
        Set objDACL = objSecDescriptor.Properties_.Item("DACL")

        If F_strAccountLocation = "1" Then
            objDACL.Value(0) = objSiteAdminAce
            objDACL.Value(1) = objAdminAce
            objDACL.Value(2) = objAnonAce
        ElseIf F_strAccountLocation = "2" Then
            objDACL.Value(0) = objSiteAdminAce
            objDACL.Value(1) = objAdminAce
            objDACL.Value(2) = objAnonAce
            If Not IsEmpty(objDomainAce) Then
                objDACL.Value(3) = objDomainAce
            End If
        End If

        objSecDescriptor.Properties_.Item("ControlFlags") = 32772
        Set objSecDescriptor.Properties_.Item("Owner") = objSiteAdminAce.Trustee

        Err.Clear

        retval = objSecSetting.SetSecurityDescriptor( objSecDescriptor )
        if Err.number <> 0 then
            Call SA_TraceOut ( "site_new", _
                "Failed to set the Security Descriptor for Root dir ")
            exit function
        end if

        Call SA_TraceOut ("site_new", "In SetDaclForRootDir success" )

        SetDaclForRootDir = TRUE

        'Release the objects
        set objService = nothing
        set objSecSetting = nothing
        set objSecDescriptor = nothing
    End function

    '-------------------------------------------------------------------------
    'Function name        :blnDeleteUser
    'Description        :Deletes users if site not created
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Sub blnDeleteUser(objRoot, strUserName)
        On Error Resume Next
        Err.Clear

        Dim nretval            'to hold return value

        'deletes the Anonymous User from the System
        nretval = objRoot.Delete("user" , strUserName)
        If Err.Number <> 0 Then
            Call SA_TraceOut ("site_new", L_CANNOTDELETE_CREATEDUSERS_ERRORMESSAGE )
        End If
    End Sub

    '-------------------------------------------------------------------------
    'Function name        :DeleteWebSite
    'Description        :Deletes the web site
    'Input Variables    :objService, strSiteNum
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function DeleteWebSite( objService, strSiteNum )
        On Error Resume Next
        Err.Clear

        Dim strObjPath        'holds site collection
        Dim objWebSite        'holds instance of the site
        DeleteWebSite = FALSE

        strObjPath = GetIISWMIProviderClassName("IIs_WebServer") & ".Name=" & chr(34) & strSiteNum & chr(34)
        Set objWebSite = objService.Get(strObjPath)
        if Err.Number <> 0 then
            Call SA_TraceOut("site_new","Unable to get the web server object ")
            Exit Function
        End If

        'delete the object
        objWebSite.Delete_
        if Err.Number <> 0 then
            SA_TraceOut "site_new", "Unable to delete the web site "
            Exit Function
        End If

        DeleteWebSite = TRUE

        'Release the object
        set objWebSite = nothing
    End Function


    '-------------------------------------------------------------------------
    'Function name        :blnCreateIISOperator
    'Description        :creates operators for the site
    'Input Variables    :objService, strSiteNum
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function blnCreateIISOperator(objService, strSiteNum,strAdminName)
        On Error Resume Next
        Err.Clear

        Dim objACE                        'holds ACE
        Dim strQuery                    'holds Query string
        Dim objAdminACLInstanceSet        'holds Admin ACL instanceset
        Dim objAdminACLInstance            'holds Admin ACL instance

        blnCreateIISOperator = FALSE
        strQuery= GetIISWMIProviderClassName("IIs_AdminACL") & ".Name='" & strSiteNum &"'"
        set objAdminACLInstanceSet = objService.Get(strQuery)
        if err.number<>0 then
            'note action req
            SetErrMsg L_INFORMATION_ERRORMESSAGE
            exit function
        end if

        set objACE = objService.Get(GetIISWMIProviderClassName("IIs_ACE")).SpawnInstance_()

        if err.number <>0 then
            SetErrMsg L_INFORMATION_ERRORMESSAGE
            exit function
        end if

        objACE.Name = objAdminACLInstanceSet.Name
        objACE.AccessMask = 11
        objACE.AceFlags = 0
        objACE.AceType = 0
        objACE.Trustee = strAdminName
        objACE.Put_(WBEMFLAG)

        blnCreateIISOperator = TRUE

        'release objects
        set objACE = nothing
        set objAdminACLInstanceSet = nothing
    End function

    '-------------------------------------------------------------------------
    'Function name        :ValidateSitePath
    'Description        :Validate Directory path, creates if necessary
    'Input Variables    :None
    'Output Variables    :None
    'Returns            :Boolean
    'Global Variables    :None
    '-------------------------------------------------------------------------
    Function ValidateSitePath(strCreatePathChecked,strFormDir)
        Err.Clear
        on error resume next

        Dim objFso                    'holds FileSystem object
        Dim strDir                    'holds Director path
        Dim strIndx                    'holds index value
        Dim strDriveName            'holds drive name
        Dim strQuery                'holds Query string
        Dim objService                'holds WMI Connection
        Dim objDirList                'holds Virtualdirectory collection list
        Dim objDir                    'holds instance of Virtualdirectory list
        Dim strParentDir            'holds parent directory path
        Dim nRetVal                    'holds return value
        Dim strDirPath                'holds directory path
        Dim strWinDirPath            'holds windows directory path

        ValidateSitePath = false

        Set objFso = server.CreateObject("Scripting.FileSystemObject")
        if Err.number <> 0 then
            SetErrMsg L_FILEINFORMATION_ERRORMESSAGE
            exit function
        end if

        Call SA_TRACEOUT("ValidateSitePath", CStr(strCreatePathChecked))
        if strCreatePathChecked <> "true" then
            'if folder does not exist, give error as folder does not exist
            if objFso.FolderExists(strFormDir)=false then
                SetErrMsg L_DIR_DOESNOT_EXIST_ERRMSG
                exit function
            end if
        end if

        Set objService = getWMIConnection(CONST_WMI_IIS_NAMESPACE)

        strQuery = "select path from " & GetIISWMIProviderClassName("IIs_WebVirtualDirSetting")
        set objDirList=objService.Execquery(strQuery)
        if Err.number <> 0 then
            SetErrMsg L_INFORMATION_ERRORMESSAGE
            exit function
        end if

        'truncate last '\' char
        if Right( strFormDir, 1 ) = "\" then
            strFormDir = Left(strFormDir, len(strFormDir) - 1)
        end if

        strParentDir = objFso.GetParentFolderName(strFormDir)

        for each objDir in objDirList
            if  strComp(objDir.path, strFormDir, 0) = 0  OR  _
                strComp(objDir.path, strParentDir, 0) = 0 then
                mintTabSelected = 0
                SetErrMsg L_DIR_FOR_WEB_SITES_TEXT
                exit function
            end if
        next

        'check whether the Dir entered is Windows dir
        if len(objFso.GetSpecialFolder(0)) = len(strFormDir) then
            strWinDirPath = objFso.GetSpecialFolder(0)
        else
            strWinDirPath = objFso.GetSpecialFolder(0) & "\"
        end if

        strDirPath = mid(strFormDir,1,len(strWinDirPath))

        if StrComp(trim(strDirPath),strWinDirPath,1) = 0 then

            SetErrMsg L_INVALID_DIR_PATH_ERRMSG
            mintTabSelected = 0

            exit Function

        end if

        nRetVal = CreateSitePath( objFso, strFormDir )

        if nRetVal <> CONST_SUCCESS then

            if nRetVal = CONST_INVALID_DRIVE then

                SetErrMsg L_INVALID_DRIVE_ERRMSG

            elseif nRetVal = CONST_NOTNTFS_DRIVE then

                SetErrMsg L_NOT_NTFS_DRIVE_ERRMSG

            else

                SetErrMsg L_FAILED_CREATE_DIR_ERRMSG

            end if

            mintTabSelected = 0

            exit Function

        end if


        'release objects
        set objFso = nothing
        set objDirList = nothing
        set objService = nothing

        ValidateSitePath = true
    end function

%>